home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / getopt.exe / GETOPT_.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-08  |  7KB  |  230 lines
  1. {
  2.    Original module in C is
  3.    Copyright (c) 1986,1992 by Borland International Inc.
  4.    All Rights Reserved.
  5.    %% port to BPASCAL and enhancements by Juancarlo Anez
  6.    %% CIS id [73000,1064]
  7.    %% date 92.04.08
  8. }
  9. UNIT GETOPT_;
  10. INTERFACE
  11.  
  12.   CONST
  13.     MaxArgs   = 50;          { Maximun number of comandline arguments }
  14.     MaxCmdLin = 255;         { Maximun comandline lenth }
  15.     EOFch     = #24;          { returned by getOpt when no more options }
  16.     NONOPTch  = '√';          { returned by getOpt when arg is non-option}
  17.     ERRORch   = #1;
  18.     UNKNOWNch = '?';
  19.  
  20.     optind :Integer   = 1;       { index of which argument is next   }
  21.     optarg :pChar     = nil;     { pointer to argument of current option }
  22.     opterr :Boolean   = FALSE;   { allow error message   }
  23.     argc :Integer = 0;           { count of non-opt arguments when
  24.                                    getOpt has returned EOFch }
  25.   VAR
  26.     argv :array[0..MaxArgs] of pChar; { non-opt arguments }
  27.  
  28.   function getopt(optionS:pChar):Char;
  29.  
  30. {
  31.   Parse the command line options, System V style.
  32.  
  33.   The original standard option syntax is:
  34.  
  35.     option ::= SW [optLetter]* [argLetter space* argument]
  36.  
  37.   %%% 92.04.08 -- Juancarlo Anez, CIS 73000,1064
  38.   It has been augmented to:
  39.  
  40.     option ::= SW ([optLetter]* [argLetter space* argument])*
  41.  
  42.   In ohter words, options and non-options may be interplaced.
  43.   Additionaly, after getOpt returns EOFch, argv[] will point only to
  44.   non-options and argc will be the exact count of them
  45.   %%%
  46.  
  47.   where
  48.     - SW is either '/' or '-', according to the current setting
  49.       of the MSDOS switchar (int 21h function 37h).
  50.     - there is no space before any optLetter or argLetter.
  51.     - opt/arg letters are alphabetic, not punctuation characters.
  52.     - optLetters, if present, must be matched in optionS.
  53.     - argLetters, if present, are found in optionS followed by ':'.
  54.     - argument is any white-space delimited string.  Note that it
  55.       can include the SW character.
  56.     - upper and lower case letters are distinct.
  57.  
  58.   There may be multiple option clusters on a command line, each
  59.   beginning with a SW, but all must appear before any non-option
  60.   arguments (arguments not introduced by SW).  Opt/arg letters may
  61.   be repeated: it is up to the caller to decide if that is an error.
  62.  
  63.   The character SW appearing alone as the last argument is an error.
  64.   The lead-in sequence SWSW ("--" or "//") causes itself and all the
  65.   rest of the line to be ignored (allowing non-options which begin
  66.   with the switch char).
  67.  
  68.   The string *optionS allows valid opt/arg letters to be recognized.
  69.   argLetters are followed with ':'.  Getopt () returns the value of
  70.   the option character found, or EOF if no more options are in the
  71.   command line.    If option is an argLetter then the global optarg is
  72.   set to point to the argument string (having skipped any white-space).
  73.  
  74.   The global optind is initially 1 and is always left as the index
  75.   of the next argument of argv[] which getopt has not taken.  Note
  76.   that if "--" or "//" are used then optind is stepped to the next
  77.   argument before getopt() returns EOF.
  78.  
  79.   If an error occurs, that is an SW char precedes an unknown letter,
  80.   then getopt() will return a '?' character and normally prints an
  81.   error message via perror().  If the global variable opterr is set
  82.   to false (zero) before calling getopt() then the error message is
  83.   not printed.
  84.  
  85.   For example, if the MSDOS switch char is '/' (the MSDOS norm) and
  86.  
  87.     *optionS == "A:F:PuU:wXZ:"
  88.  
  89.   then 'P', 'u', 'w', and 'X' are option letters and 'F', 'U', 'Z'
  90.   are followed by arguments.  A valid command line may be:
  91.  
  92.     aCommand  /uPFPi /X /A L someFile
  93.  
  94.   where:
  95.     - 'u' and 'P' will be returned as isolated option letters.
  96.     - 'F' will return with "Pi" as its argument string.
  97.     - 'X' is an isolated option.
  98.     - 'A' will return with "L" as its argument.
  99.     - "someFile" is not an option, and terminates getOpt.  The
  100.       caller may collect remaining arguments using argv pointers.
  101. }
  102.  
  103.  
  104.  
  105. IMPLEMENTATION
  106.   USES
  107.     WINDOS,
  108.     STRINGS;
  109.  
  110.    CONST
  111.      letP :pChar = nil;  { remember next option char's location }
  112.      SW   :Char  =  #0;  { DOS switch character, either '-' or '/' }
  113.    VAR
  114.      cmdlin :array[0..MaxCmdLin] of Char;
  115.  
  116.      { delete an already processed option from argv }
  117.      procedure compressArgs(i :Integer);
  118.        begin
  119.          while i < argc
  120.          do begin
  121.            argv[i] := argv[i+1];
  122.            inc(i)
  123.          end;
  124.          argv[argc] := nil;
  125.          dec(argc)
  126.        end;
  127.  
  128.      { initialization, determine argc and argv
  129.        using the parsing already done by WINDOS unit
  130.      }
  131.      procedure init;
  132.        var
  133.          i :Integer;
  134.          pos :pChar;
  135.          regs :TRegisters;
  136.        begin
  137.           { get SW using dos call 0x37 }
  138.           regs.AX := $3700;
  139.           msDOS(regs);
  140.           SW := Char(regs.DL);
  141.           argc := getArgCount;
  142.           pos := cmdlin;
  143.           for i := 0 to argc
  144.           do begin
  145.             argv[i] := pos;
  146.             getArgStr(pos, i, 512-(pos-cmdlin));
  147.             pos := strEnd(pos);
  148.             inc(pos);
  149.           end;
  150.           pos^ := #0;
  151.           for i := argc+1 to MaxArgs
  152.           do
  153.             argv[i] := nil;
  154.        end;
  155.  
  156.   function getopt(optionS:pChar):Char;
  157.     label
  158.       gopERROR;
  159.     var
  160.        ch     :array[0..1] of Char;
  161.        optP   :pChar;
  162.     begin
  163.        if (SW = #0)
  164.        then
  165.          init;
  166.  
  167.        ch[0]  := EOFch;
  168.        ch[1] := #0;
  169.        optarg := nil;
  170.        while (optind <= argc)
  171.        do begin
  172.           if (letP = nil) then begin
  173.              letP := argv[optind];
  174.              if (letP = nil) then break;
  175.              if not (letP^ in [SW,'-','/'])then begin
  176.                optArg := letP;
  177.                letP := nil;
  178.                ch[0] := NONOPTch;
  179.                inc(optind);
  180.                break
  181.              end;
  182.              compressArgs(optind);
  183.              inc(letP);
  184.              if letP^ in [SW,'-','/'] then begin
  185.                 letP := nil;
  186.                 optind := argc+1;
  187.                 break;
  188.              end
  189.           end;
  190.           ch[0]  := letP^;
  191.           if ch[0] = #0 then goto gopERROR;
  192.           optP := strPos(optionS, ch);
  193.           if (ch[0] = ':') or (optP = nil) then goto gopError;
  194.           inc(letP);
  195.           inc(optP);
  196.           if (optP^ = ':')
  197.           then begin
  198.              if (letP^ = #0)
  199.              then begin
  200.                if (optind >= argc) then goto  gopError;
  201.                letP := argv[optind];
  202.                compressArgs(optind)
  203.              end;
  204.              optarg := letP;
  205.              letP   := nil;
  206.           end
  207.           else  begin
  208.              if (letP^ = #0)
  209.              then begin
  210.                 letP := nil
  211.              end;
  212.              optarg := nil;
  213.           end;
  214.           break
  215.        end;
  216.        getopt := ch[0];
  217.        exit;
  218.  
  219.     gopError:
  220.        if (opterr)
  221.        then begin
  222.           writeln(output,'Error, unknown switch',SW,ch[0]);
  223.           halt(1)
  224.        end;
  225.        getopt := ERRORch;
  226.        optArg := letP;
  227.        letP := nil;
  228.        exit;
  229.   end;
  230. END.